home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / ansi.swg / 0022_ANSI Bulletin files.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-11-02  |  4.1 KB  |  146 lines
  1. {
  2. > Now that I need to make a .ANS bulletin Type File, I was wondering
  3. > how to Write from a Pascal Program, ANSI control Characters to a
  4. > File and produce nice color bulletin screen to be displayed by RA.
  5.  
  6. The following Unit will enable you to Write Ansi sequences to a Text
  7. File Without having to look them up yourself. It enables you to do this
  8. using the (easier) Crt Unit style of commands, and provides the optimum
  9. Ansi sequence to do the job.
  10. }
  11.  
  12. Unit AnsiOut;
  13. {1. Contains reduced set of Procedures from AnsiCrt Unit by I.Hinson.}
  14. {2. Modified to provide output to a Text File.}
  15.  
  16. Interface
  17.  
  18. Const Black = 0;     Blue = 1;          Green = 2;       Cyan = 3;
  19.       Red =   4;     Magenta = 5;       Brown = 6;       LightGray = 7;
  20.       DarkGray = 8;  LightBlue = 9;     LightGreen = 10; LightCyan = 11;
  21.       LightRed = 12; LightMagenta = 13; Yellow = 14;     White = 15;
  22.       Blink = 128;
  23.  
  24. Var AnsiFile: Text;
  25.  
  26. Procedure TextColor(fore : Byte);
  27. Procedure TextBackGround(back : Byte);
  28. Procedure NormVideo;
  29. Procedure LowVideo;
  30. Procedure HighVideo;
  31. Procedure ClrEol;
  32. Procedure ClrScr;
  33.  
  34. Implementation
  35.  
  36. Const
  37.   forestr : Array [Black..LightGray] of String[2] =
  38.     ('30','34','32','36','31','35','33','37');
  39.   backstr : Array [Black..LightGray] of String[2] =
  40.     ('40','44','42','46','41','45','43','47');
  41.   decisiontree : Array [Boolean, Boolean, Boolean, Boolean] of Integer =
  42.     ((((0,1),(2,0)),((1,1),(3,3))),(((4,5),(6,4)),((0,5),(2,0))));
  43.  
  44. Var forecolour, backcolour: Byte; { stores last colours set }
  45.     boldstate, blinkstate: Boolean;
  46.  
  47. Procedure TextColor(fore : Byte);
  48.   Var
  49.     blinknow, boldnow: Boolean;
  50.     outstr: String;
  51.   begin
  52.     blinknow := (fore and $80) = $80;
  53.     boldnow := (fore and $08) = $08;
  54.     fore := fore and $07;  { mask out intensity and blink attributes }
  55.     forecolour := fore;
  56.     Case decisiontree[blinknow, blinkstate, boldnow, boldstate] OF
  57.     0: outstr := Concat(#27,'[',forestr[fore],'m');
  58.     1: outstr := Concat(#27,'[0;',backstr[backcolour],';',forestr[fore],'m');
  59.     2: outstr := Concat(#27,'[1;',forestr[fore],'m');
  60.     3: outstr :=
  61.          Concat(#27,'[0;1;',backstr[backcolour],';',forestr[fore],'m');
  62.     4: outstr := Concat(#27,'[5;',forestr[fore],'m');
  63.     5: outstr :=
  64.          Concat(#27,'[0;5;',backstr[backcolour],';',forestr[fore],'m');
  65.     6: outstr := Concat(#27,'[1;5;',forestr[fore],'m');
  66.     end; { Case }
  67.     Write(AnsiFile,outstr);
  68.     blinkstate := blinknow;
  69.     boldstate := boldnow;
  70.   end;
  71.  
  72. Procedure TextBackGround(back: Byte);
  73.   Var outString: String;
  74.   begin
  75.     if Back > 7 then Exit; { No such thing as bright or blinking backgrounds }
  76.     BackColour := Back;
  77.     outString := Concat(#27,'[',backstr[back],'m');
  78.     Write(AnsiFile,outString)
  79.   end;
  80.  
  81. Procedure NormVideo;
  82.   begin
  83.     Write(AnsiFile,#27'[0m');
  84.     forecolour := LightGray;
  85.     backcolour := Black;
  86.     boldstate := False;
  87.     blinkstate := False
  88.   end;
  89.  
  90. Procedure LowVideo;
  91.   begin
  92.     if blinkstate then forecolour := forecolour or $80;  { retain blinking }
  93.     TextColor(forecolour);   { stored forecolour never contains bold attr }
  94.   end;
  95.  
  96. Procedure HighVideo;
  97.   begin
  98.     if not boldstate then
  99.     begin
  100.       boldstate := True;
  101.       Write(AnsiFile,#27,'[1m')
  102.     end;
  103.   end;
  104.  
  105. Procedure ClrEol;
  106.   begin
  107.     Write(AnsiFile,#27'[K')
  108.   end;
  109.  
  110. Procedure ClrScr;
  111.   begin
  112.     Write(AnsiFile,#27'[2J');
  113.   end;
  114.  
  115. begin
  116.   forecolour := LightGray;
  117.   backcolour := Black;
  118.   boldstate := False;
  119.   blinkstate := False
  120. end.
  121.  
  122.  
  123. Program Demo;
  124. Uses
  125.   AnsiOut;
  126. begin
  127.   Assign(AnsiFile,'CON');   { or a File - e.g. 'MYSCREEN.ANS' }
  128.   ReWrite(AnsiFile);
  129.   ClrScr;
  130.   TextColor(Blue);
  131.   TextBackGround(LightGray);
  132.   Writeln(AnsiFile,' Blue Text on LightGray ');
  133.   HighVideo;
  134.   Write(AnsiFile,' Now the Text is LightBlue ');
  135.   TextBackground(Red);
  136.   Writeln(AnsiFile,' on a Red background');
  137.   TextColor(Black+Blink);
  138.   TextBackground(Cyan);
  139.   Writeln(AnsiFile,' Blinking Black ');
  140.   TextBackGround(Green);
  141.   ClrEol;         { a blank Green line }
  142.   Writeln(AnsiFile);
  143.   NormVideo;
  144.   Close(AnsiFile);
  145. end.
  146.